home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Scene 96
/
Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso
/
misc
/
coding
/
onenssrc
/
part3.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-01-17
|
6KB
|
325 lines
unit Part3;
interface
uses
zipvga, liktwk, crt, oneres, fastsine;
procedure Run;
implementation
const
firstframe = 2048;
lastframe1 = firstframe + 1024;
lastframe2 = lastframe1 + 1024 - 512;
var
i, j, k, d : word;
swerve : integer;
aswerve : word;
f : longint;
scr, tab, pic : ^screen2;
scrs, tabs, pics : word;
procedure MakePic;
var
i, j : word;
begin
for i := 0 to 65535 do
vscr2[i] := random(128) + random(128) + 1;
pic^ := vscr2;
{for i := 0 to 65535 do
vscr2[i] := (pic^[i+1] + pic^[i-1] + pic^[i+256] + pic^[i-256]) div 8
+ (pic^[i+321] + pic^[i - 321] + pic^[i+319] - pic^[i-319]) div 8;}
for j := 0 to 2 do
begin
for i := 0 to 65535 do
vscr2[i] := (pic^[i+1] + pic^[i] + pic^[i+320] + pic^[i+321]) div 4 + random(4) - random(4);
pic^ := vscr2;
end;
end;
procedure MakeTabs;
var
dx, dy : integer;
z, d : longint;
begin
init60hz256256256c;
brightness (63,0);
{if not loadpic2('thing.tab', tab^) then}
begin
for dx := -128 to 127 do
begin
for dy := -64 to 63 do
begin
if dx = 0 then
begin
if dy > 0 then
tab^[(dy + 64)*256 + dx + 128] := 64
else
tab^[(dy + 64)*256 + dx + 128] := 192;
end
else
tab^[(dy + 64)*256 + dx + 128] := round(arctan(dy/dx)*256/2/pi);
if dx < 0 then
tab^[(dy + 64)*256 + dx + 128] := tab^[(dy + 64)*256 + dx + 128];
end;
vscr2 := tab^;
end;
for dx := -128 to 127 do
begin
for dy := -64 to 63 do
begin
tab^[(dy + 64)*256 + 128*256 + dx + 128] := (tab^[(dy + 64)*256 + dx + 128] + 128) and 255;
end;
vscr2 := tab^;
end;
savepic2 ('thing.tab', tab^);
end;
vscr2 := tab^;
initvga;
end;
procedure Run;
begin
{new (scr);}
scr := @vscr2;
new (tab);
new (pic);
scrs := seg(scr^);
tabs := seg(tab^);
pics := seg(pic^);
initb;
initi;
initvga;
brightness (0, 0);
{MakePic;}
{readkey;}
{MakeTabs;
readkey;}
fetch ('tunnel.tab');
blockread (lf, tab^, 65535);
fetch ('voxel.mp');
blockread (lf, pic^, 65535);
filldword (vscr, 16384, 0);
j := 0;
k := 0;
f := 0;
swerve := 0;
repeat
getpos;
f := track*256 + row*4;
if f < firstframe + 256 then
brightness ((f - firstframe) div 4, 0)
else if f > lastframe1 - 64 then
brightness ((lastframe1 - f), 0);
{for i := 0 to 32767 do
begin
d := tab^[i+32768];
vscr2[i+63*256] := pic^[d*256 + tab^[i] + j*3*256 + j]*(255 - d) div 256;
end;}
{retrace;}
{setrgb (0, 31, 0, 0);}
if f >= firstframe + 64 then
inc (swerve);
{swerve := ssin(f);}
aswerve := abs(swerve);
{repeat until sync;
sync := false;}
if trapretrace then
retrace;
asm
mov ax, k
mov ah, al
xor al, al
mov si, ax
add si, j
mov cx, [aswerve]
xor di, di
cmp [swerve], 0
jg @AtEnd
xor al, al
mov dx, [scrs]
mov es, dx
add di, 50*320
rep stosb
sub di, 50*320
@AtEnd:
mov cx, 32000
sub cx, [aswerve]
@Loop:
mov dx, [tabs]
mov es, dx
add di, [swerve]
mov bh, es:[di]
sub di, [swerve]
mov bl, es:[di+32768]
mov dx, [pics]
mov es, dx
mov al, es:[bx+si]
mov ah, 255
sub ah, bl
mul ah
mov dx, 0A000h {[scrs]}
mov es, dx
mov es:[di+50*320], ah
inc di
dec cx
jnz @Loop
cmp [swerve], 0
jl @AtBeginning
add di, 50*320
mov cx, [aswerve]
xor al, al
rep stosb
@AtBeginning:
end;
{setrgb (0, 0, 0, 0);}
{for i := 0 to 15 do
inc (pic^[j + k*256], random(64));}
inc (j, 2);
inc (k, 1);
until keypressed or (f >= lastframe1);
if keypressed then
readkey;
init60hz256256256c;
fetch ('thing.tab');
blockread (lf, tab^, 65535);
fetch ('voxel.mt');
blockread (lf, pic^, 65535);
filldword (vscr, 16384, 0);
j := 0;
k := 0;
f := 0;
repeat
getpos;
f := track*256 + row*4;
if f < lastframe1 + 256 then
brightness ((f - lastframe1) div 4, 0)
else if f > lastframe2 - 64 then
brightness ((lastframe2 - f), 0);
{for i := 0 to 32767 do
begin
d := tab^[i+32768];
vscr2[i+63*256] := pic^[d*256 + tab^[i] + j*3*256 + j]*(255 - d) div 256;
end;}
{retrace;}
{setrgb (0, 31, 0, 0);}
{swerve := swerve + ssin(f) div 16;}
swerve := (ssin(f*4) div 16 + scos(f*3 + 10) div 8)*256 + (ssin(f*5 + 15) div 8 + scos(f*6 + 20) div 16);
aswerve := abs(swerve);
{repeat until sync;
sync := false;}
if trapretrace then
retrace;
asm
mov ax, k
mov ah, al
xor al, al
mov si, ax
add si, j
mov cx, [aswerve]
xor di, di
{cmp [swerve], 0
jg @AtEnd}
xor al, al
mov dx, [scrs]
mov es, dx
add di, 63*256
rep stosb
sub di, 63*256
@AtEnd:
mov cx, 32768
sub cx, [aswerve]
@Loop:
mov dx, [tabs]
mov es, dx
mov bh, es:[di]
add di, [swerve]
mov bl, es:[di+32768]
sub di, [swerve]
mov dx, [pics]
mov es, dx
mov al, es:[bx+si]
{mov ah, 255
sub ah, bl
mul ah}
mov dx, 0A000h {[scrs]}
mov es, dx
mov es:[di+63*256], al
inc di
dec cx
jnz @Loop
cmp [swerve], 0
jl @AtBeginning
add di, 63*256
mov cx, [aswerve]
xor al, al
rep stosb
@AtBeginning:
end;
{setrgb (0, 0, 0, 0);}
{for i := 0 to 15 do
inc (pic^[j + k*256], random(64));}
inc (j, 2);
inc (k, 1);
until keypressed or (f >= lastframe2);
dispose (tab);
dispose (pic);
end;
end.